home *** CD-ROM | disk | FTP | other *** search
/ The Amiga Classic Collection / The Amiga Classic Collection - Disc 1.iso / Education / ED05-AmRadio1.DMS / ED05-AmRadio1.adf / Logging / Contest / Dupe.Chek (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-01-19  |  7KB  |  222 lines
  1. '{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
  2. '    C O N T E S T - D U P E  &  S A V E    P R O G R A M
  3. '          by Bj. Madsen - VE5FX      Nov. 11, 1986
  4. '}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
  5.  
  6. ' This program will allow input of callsigns for contest duping purposes.
  7. ' The callsigns will be 'duped' for match.  The program also checks
  8. ' for valid callsigns, requiring both numbers and letters and allowing
  9. ' for the inclusion of a slash.   A NEW prefix will provide
  10. ' a choice of whether to save or pass.  Callsigns will be saved to a
  11. ' pre-defined disk file every 20 entries or whenever the command <SAVE>
  12. ' is entered in place of a callsign.  At the end of the session, enter
  13. ' the word <END>.  Outstanding calls will be saved and the program will end.
  14.  
  15.  CLEAR 1000
  16.  CLEAR ,100000
  17.  DEFINT K-Z
  18.  
  19.   DIM M$(21) : DIM Z$(21) : DIM TPX$(21) :DIM PX$(2000)
  20.   DIM A$(400):DIM b$(400): DIM C$(500): DIM D$(500): DIM E$(400)
  21.   DIM F$(400): DIM G$(400): DIM H$(400): DIM I$(400): DIM J$(400) 
  22.    CLS:WINDOW 1, "WPX CONTEST DUPING PROGRAM ",(0,0)-(610,185),15
  23.    
  24.   TITLE: '----------------------------------------------------Title for menu
  25.     LINE (0,0)-(640,5),3,bf
  26.     LINE (0,0)-(10,200),3,bf
  27.     LINE (607,0)-(617,200),3,bf
  28.     LINE (0,181)-(617,186),3,bf
  29.     LINE (0,30)-(640,35),3,b
  30.     PAINT (20,10),2,3
  31.     PAINT (20,33),1,3
  32.     COLOR 3,2
  33.     LOCATE 3,25:PRINT " VE5FX  -*-  CONTEST DUPER "
  34.     COLOR 2,3 :PRINT :PRINT 
  35.  
  36.     PRINT :PRINT :PRINT TAB(10)"  To save fewer than 20 calls to disk, enter the word <SAVE>  "
  37.     PRINT TAB(22)"  rather than the regular callsign..... "
  38.     PRINT:PRINT TAB(15)">>>>> shift NOW to UPPER CASE LETTERS <<<<<"
  39.    
  40.     COLOR 1,0
  41.     PRINT :PRINT :PRINT TAB(15)"Are there calls to be entered from a disk file";:INPUT A$
  42.        IF LEFT$(A$,1) = "Y" THEN GOTO LOAD.CALLS
  43. 'Create a file on disk
  44.     PRINT :PRINT :PRINT  TAB(15)"What filename do you wish to use";:INPUT DUPEFILE$
  45.      PRINT :COLOR 2,3:PRINT TAB(15)"Creating output file named: ";DUPEFILE$ :COLOR 1,0
  46.       OPEN DUPEFILE$ FOR OUTPUT AS #1 
  47.       CLOSE #1
  48. 'Set up input windows
  49. SET.WINDOW:
  50.    CLS
  51.     WINDOW 1,"BASIC WINDOW",(120,15)-(400,170),15
  52.     WINDOW 2,"Contest Listing for VE5FX ",(1,1)-(610,10),2
  53.  
  54. DATA.ENTRY:                                 'Get callsign for entry
  55.       WINDOW OUTPUT 2 : COLOR 1,2: CLS
  56.       INPUT"What is the callsign.....";CS$
  57.       IF CS$ = "SAVE" OR CS$ = "END" THEN GOSUB  SAVE.TO.DISK: GOTO DATA.ENTRY
  58.       
  59. 'Check callsign for validity
  60.     N=0 : P=0 : L=0
  61.     FOR V=1 TO LEN(CS$)
  62.       X$ = MID$(CS$,V,1)
  63.         IF X$<"/" OR X$>"9" AND X$<"A" OR X$>"Z" THEN N=N+1
  64.          IF X$>"/" AND X$<":" THEN P=V
  65.         IF X$>"@" AND X$<"[" THEN L=V
  66.      NEXT V   
  67.         IF (N>0) OR (P=0) OR (L=0) THEN GOTO FLASH
  68.      ON VAL(MID$(CS$,P,1)) GOTO ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE  
  69.      IF VAL(MID$(CS$,P,1))=0 THEN ZERO
  70.      
  71. FLASH:               'Data entry error message for invalid callsigns
  72.   WINDOW OUTPUT 2: COLOR 1,2
  73.     FOR V = 1 TO 10
  74.      BEEP
  75.      PRINT TAB(10)">>>>> I N V A L I D    C A L L S I G N <<<<<"
  76.     NEXT V
  77.   GOTO DATA.ENTRY 
  78.   
  79. ONE:
  80.   FOR X=1 TO A
  81.     IF A$(X) = CS$ THEN K$=A$(X): GOTO DUPE.TELL
  82.   NEXT X  
  83.     GOSUB SAVE.CALL
  84.     IF C$="S" THEN A=A+1: A$(A)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,A$(A),A
  85.   GOTO DATA.ENTRY
  86.   
  87. TWO:
  88.     FOR X=1 TO b
  89.     IF b$(X) = CS$ THEN K$=b$(X): GOTO DUPE.TELL
  90.   NEXT X  
  91.     GOSUB SAVE.CALL
  92.     IF C$="S" THEN b=b+1: b$(b)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,b$(b),b
  93.   GOTO DATA.ENTRY
  94.    
  95. THREE:
  96.   FOR X=1 TO C
  97.     IF C$(X) = CS$ THEN K$=C$(X): GOTO DUPE.TELL
  98.   NEXT X  
  99.     GOSUB SAVE.CALL
  100.     IF C$="S" THEN C=C+1: C$(C)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,C$(C),C
  101.   GOTO DATA.ENTRY
  102.  
  103. FOUR:
  104.   FOR X=1 TO D
  105.     IF D$(X) = CS$ THEN K$=D$(X): GOTO DUPE.TELL
  106.   NEXT X  
  107.     GOSUB SAVE.CALL
  108.     IF C$="S" THEN D=D+1: D$(D)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,D$(D),D
  109.   GOTO DATA.ENTRY
  110.  
  111. FIVE:
  112.   FOR X=1 TO E
  113.     IF E$(X) = CS$ THEN K$=E$(X): GOTO DUPE.TELL
  114.   NEXT X  
  115.     GOSUB SAVE.CALL
  116.     IF C$="S" THEN E=E+1: E$(E)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,E$(E),E
  117.   GOTO DATA.ENTRY
  118.  
  119. SIX:
  120.   FOR X=1 TO F
  121.     IF F$(X) = CS$ THEN K$=F$(X): GOTO DUPE.TELL
  122.   NEXT X  
  123.     GOSUB SAVE.CALL
  124.     IF C$="S" THEN F=F+1: F$(F)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,F$(F),F
  125.   GOTO DATA.ENTRY
  126.  
  127. SEVEN:
  128.   FOR X=1 TO G
  129.     IF G$(X) = CS$ THEN K$=G$(X): GOTO DUPE.TELL
  130.   NEXT X  
  131.     GOSUB SAVE.CALL
  132.     IF C$="S" THEN G=G+1: G$(G)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,G$(G),G
  133.   GOTO DATA.ENTRY
  134.  
  135. EIGHT: 
  136.   FOR X=1 TO H
  137.     IF H$(X) = CS$ THEN K$=H$(X): GOTO DUPE.TELL
  138.   NEXT X  
  139.     GOSUB SAVE.CALL
  140.     IF C$="S" THEN H=H+1: H$(H)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,H$(H),H
  141.   GOTO DATA.ENTRY
  142.  
  143. NINE:
  144.   FOR X=1 TO I
  145.     IF I$(X) = CS$ THEN K$=I$(X): GOTO DUPE.TELL
  146.   NEXT X  
  147.     GOSUB SAVE.CALL
  148.     IF C$="S" THEN I=I+1: I$(I)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,I$(I),I
  149.   GOTO DATA.ENTRY
  150.  
  151. ZERO:
  152.   FOR X=1 TO J
  153.     IF J$(X) = CS$ THEN K$=J$(X): GOTO DUPE.TELL
  154.   NEXT X  
  155.     GOSUB SAVE.CALL
  156.     IF C$="S" THEN J=J+1: J$(J)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,J$(J),J
  157.   GOTO DATA.ENTRY
  158.    
  159. DUPE.TELL:
  160.    WINDOW OUTPUT 2: COLOR 2,1
  161.    FOR V=1 TO 10: BEEP
  162.      PRINT TAB(10) "  DUPE ==> ";K$;" is already on file.....  "
  163.    NEXT V: GOTO DATA.ENTRY 
  164.    
  165. SAVE.CALL:
  166.    WINDOW OUTPUT 2: COLOR 2,1
  167.      PRINT TAB(10)"  " CS$;" is a new call...<S>ave or <P>ass?  ";
  168.     LOOP:
  169.      C$=INKEY$
  170.        IF C$ = "S" THEN M=M+1: M$(M)=CS$
  171.        IF M = 20 THEN GOSUB SAVE.TO.DISK: RETURN
  172.        IF C$ = "S" THEN RETURN
  173.        IF C$ = "P" THEN RETURN
  174.      GOTO LOOP
  175.      
  176. SAVE.TO.DISK:               'save 20 calls or fewer to disk file
  177.   WINDOW OUTPUT 1: COLOR 3,0
  178.   PRINT "Saving ";M;" calls to file: ";DUPEFILE$
  179.     OPEN "A",#1, DUPEFILE$
  180.       FOR V=1 TO M
  181.          PRINT #1, M$(V)
  182.       NEXT V
  183.     CLOSE #1: M=0 : COLOR 1,0
  184.    IF CS$ = "END" THEN END :ELSE RETURN
  185.     
  186.     
  187. LOAD.CALLS:            'load previously created file from disk
  188.   CLS:PRINT :PRINT :INPUT"What filename do you wish to load";DUPEFILE$
  189.   OPEN "I",#1,DUPEFILE$
  190.    WHILE NOT EOF(1)
  191.     INPUT #1, CS$
  192.       FOR V=1 TO LEN(CS$)
  193.         X$=MID$(CS$,V,1)
  194.         IF X$>"/" AND X$<":" THEN N=VAL(X$)    'N is value of last number
  195.       NEXT V
  196.     
  197.       ON N GOTO WON,TOO,THR,FER,FIV,SEX,SEV,ATE,NIN
  198.       IF N = 0 THEN DIX
  199.     WON:  A=A+1: A$(A)=CS$: GOTO LAST
  200.     TOO:  b=b+1: b$(b)=CS$: GOTO LAST
  201.     THR:  C=C+1: C$(C)=CS$: GOTO LAST
  202.     FER:  D=D+1: D$(D)=CS$: GOTO LAST 
  203.     FIV:  E=E+1: E$(E)=CS$: GOTO LAST
  204.     SEX:  F=F+1: F$(F)=CS$: GOTO LAST
  205.     SEV:  G=G+1: G$(G)=CS$: GOTO LAST
  206.     ATE:  H=H+1: H$(H)=CS$: GOTO LAST
  207.     NIN:  I=I+1: I$(I)=CS$: GOTO LAST
  208.     DIX:  J=J+1: J$(J)=CS$: GOTO LAST
  209.     LAST:
  210.   WEND
  211.    CLOSE #1: COLOR 2,3: PRINT :PRINT :PRINT 
  212.    PRINT "     A total of ";A+b+C+D+E+F+G+H+I+J;" callsigns on file     "
  213.    COLOR 3,0:PRINT :PRINT 
  214.    INPUT"Press <RETURN> to continue.....";C$
  215.   GOTO SET.WINDOW
  216.   
  217.     
  218.     
  219.     
  220.     
  221.     
  222.